﻿//#define SCHEME_DEBUG
#define SCHEME_PROFILING

using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;

using Scheme.Net.Runtime.AST;
using Environment = Scheme.Net.Runtime.Environment;
using EvalResult = System.Collections.Generic.IEnumerable<Scheme.Net.Runtime.AST.IEvaluable>;
using TEvalResult = Scheme.Net.Runtime.Evaluator.Trampoline<System.Collections.Generic.IEnumerable<Scheme.Net.Runtime.AST.IEvaluable>>;
using TRewriter = System.Func<Scheme.Net.Runtime.AST.Pair, Scheme.Net.Runtime.AST.IEvaluable>;

namespace Scheme.Net.Runtime.Evaluator
{
    #region Evaluator
    
    public class Evaluator
    {
        #region Fields

        private Dictionary<string, Func<Func<EvalResult, TEvalResult>, Pair, TEvalResult>> primitiveProcs;
        private Dictionary<Symbol, TRewriter> rewriters;
        private Environment environment;

        private Func<IEvaluable> readProc;
        private Action<IEnumerable<IEvaluable>> finalCont;
        private Action<IEvaluable> errorCont;
        private Port currentInputPort;
        private Port currentOutputPort;

        public Port CurrentInputPort { get { return currentInputPort; } }
        public Port CurrentOutputPort { get { return currentOutputPort; } }

        #endregion

        #region Construction

        #region Constructors

        public Evaluator(Func<IEvaluable> readProc, Action<IEnumerable<IEvaluable>> finalCont, Action<IEvaluable> errorCont,
            Port inputPort, Port outputPort)
        {
            this.readProc = readProc;
            this.finalCont = finalCont;
            this.errorCont = errorCont;
            this.currentInputPort = inputPort;
            this.currentOutputPort = outputPort;
            SetupRewriters();
            primitiveProcs = new Dictionary<string, Func<Func<EvalResult, TEvalResult>, Pair, TEvalResult>>();
            SetupPrimitives();
            environment = SetupEnvironment();
        }

        public Evaluator(Func<IEvaluable> readProc, Action<IEnumerable<IEvaluable>> finalCont)
            : this(readProc, finalCont, x => Console.Error.WriteLine(((AST.String)x).Value), new Port(Console.In), new Port(Console.Out))
        {
        }

        public Evaluator(Func<IEvaluable> readProc, Action<IEnumerable<IEvaluable>> finalCont, Action<IEvaluable> errorCont)
            : this(readProc, finalCont, errorCont, new Port(Console.In), new Port(Console.Out))
        {
        }

        public Evaluator(Func<IEvaluable> readProc) 
            : this(readProc, x => Console.WriteLine(x), x => Console.Error.WriteLine(((AST.String)x).Value)) { }

        public Evaluator()
            : this(() => Runtime.Parser.SchemeParser.Parse(Console.ReadLine()))
        {
        }

        #endregion

        #region Primitives

        private void SetupPrimitives()
        {
            primitiveProcs = new Dictionary<string, Func<Func<EvalResult, TEvalResult>, Pair, TEvalResult>>();

            primitiveProcs["UNSPECIFIED-VALUE"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.UnspecifiedValue(x.Values) }));
            primitiveProcs["UNDEFINED-VALUE"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.UndefinedValue(x.Values) }));

            #region Predicates

            #region Type Predicates

            primitiveProcs["ENVIRONMENT?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsEnvironment(x.Values) }));
            primitiveProcs["PROCEDURE?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsProcedure(x.Values) }));
            primitiveProcs["SYMBOL?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsSymbol(x.Values) }));
            primitiveProcs["VECTOR?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsVector(x.Values) }));
            primitiveProcs["NUMBER?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsNumber(x.Values) })); 
            primitiveProcs["STRING?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsString(x.Values) }));
            primitiveProcs["CHAR?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsChar(x.Values) })); 
            primitiveProcs["PAIR?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsPair(x.Values) })); 
            primitiveProcs["COMPLEX?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsNumber(x.Values) })); 
            primitiveProcs["INTEGER?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsInteger(x.Values) })); 
            primitiveProcs["REAL?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsReal(x.Values) })); 
            primitiveProcs["RATIONAL?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsRational(x.Values) }));

            #endregion

            #region Generic Equality Predicates

            primitiveProcs["EQ?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsEq(x.Values) }));
            primitiveProcs["EQV?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsEqv(x.Values) }));
            primitiveProcs["EQUAL?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsEqual(x.Values) }));

            #endregion

            #region Numeric Comparison Predicates

            primitiveProcs["ZERO?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsZero(x.Values) }));
            primitiveProcs["="] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsNumEqual(x.Values) }));
            primitiveProcs[">"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsGreater(x.Values) }));
            primitiveProcs[">="] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsGreaterEqual(x.Values) }));
            primitiveProcs["<"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsLess(x.Values) }));
            primitiveProcs["<="] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsLessEqual(x.Values) }));

            #endregion

            #region Environment Predicates

            primitiveProcs["ENVIRONMENT-HAS-PARENT?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.HasEnvironmentParent(x.Values) }));
            primitiveProcs["ENVIRONMENT-BOUND?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.EnvironmentBound(x.Values) }));

            #endregion

            #region I/O Predicates

            primitiveProcs["INPUT-PORT?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsInputPort(x.Values) }));
            primitiveProcs["OUTPUT-PORT?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsOutputPort(x.Values) }));

            #endregion

            #endregion

            #region Environment Primitives

            primitiveProcs["ENVIRONMENT-PARENT"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.EnvironmentParent(x.Values) }));
            primitiveProcs["ENVIRONMENT-BOUND-NAMES"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.EnvironmentBoundNames(x.Values) }));
            primitiveProcs["ENVIRONMENT-BINDINGS"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.EnvironmentBindings(x.Values) }));
            primitiveProcs["ENVIRONMENT-LOOKUP"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.EnvironmentLookup(x.Values) }));
            primitiveProcs["ENVIRONMENT-ASSIGN!"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.EnvironmentAssign(x.Values) }));

            #endregion

            #region I/O Primitives

            primitiveProcs["WRITE-CHAR"] = (cont, x) =>
            {
                var v = x.Values;
                if (v.Count() == 2)
                    return new TEvalResult(() => cont(new IEvaluable[] { Primitives.WriteChar(v) }));
                else
                    return new TEvalResult(() => cont(new IEvaluable[] { Primitives.WriteChar(new IEvaluable[] { v.First(), CurrentOutputPort }) }));
            };
            primitiveProcs["READ"] = (cont, x) =>
            {
                var v = x.Values;
                if (v.Count() == 1)
                    return new TEvalResult(() => cont(new IEvaluable[] { Primitives.Read(v) }));
                else
                    return new TEvalResult(() => cont(new IEvaluable[] { Primitives.Read(new IEvaluable[] { CurrentInputPort }) }));
            };
            primitiveProcs["ERROR"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Error(x.Values) }));

            primitiveProcs["CURRENT-INPUT-PORT"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { currentInputPort }));
            primitiveProcs["CURRENT-OUTPUT-PORT"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { currentOutputPort }));

            primitiveProcs["CLOSE-INPUT-PORT"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.CloseInputPort(x.Values) }));
            primitiveProcs["CLOSE-OUTPUT-PORT"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.CloseOutputPort(x.Values) }));

            primitiveProcs["OPEN-INPUT-FILE"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.OpenInputFile(x.Values) }));
            primitiveProcs["OPEN-OUTPUT-FILE"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.OpenOutputFile(x.Values) }));

            primitiveProcs["EOF-OBJECT?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsEofObject(x.Values) }));

            #endregion

            #region Pair Creation and Manipulation

            primitiveProcs["CAR"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Car(x.Values) }));
            primitiveProcs["CDR"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Cdr(x.Values) }));
            primitiveProcs["SET-CAR!"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.SetCar(x.Values) }));
            primitiveProcs["SET-CDR!"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.SetCdr(x.Values) }));
            primitiveProcs["CONS"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Cons(x.Values) }));

            #endregion

            #region Vector Creation and Manipulation

            primitiveProcs["VECTOR"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.MakeVector(x.Values) }));
            primitiveProcs["VECTOR-REF"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.VectorRef(x.Values) }));
            primitiveProcs["VECTOR-LENGTH"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.VectorLength(x.Values) }));
            primitiveProcs["VECTOR-SET!"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.VectorSet(x.Values) }));
            primitiveProcs["LIST->VECTOR"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.ListToVector(x.Values) }));
            primitiveProcs["VECTOR->LIST"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.VectorToList(x.Values) }));

            #endregion

            #region Numbers

            primitiveProcs["NUMERATOR"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Numerator(x.Values) }));
            primitiveProcs["DENOMINATOR"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Denominator(x.Values) }));

            primitiveProcs["+"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Add(x.Values) }));
            primitiveProcs["*"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Multiply(x.Values) }));
            primitiveProcs["-"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Subtract(x.Values) }));
            primitiveProcs["/"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Divide(x.Values) }));

            primitiveProcs["NUMBER->STRING"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.NumberToString(x.Values) }));
            primitiveProcs["STRING->NUMBER"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.StringToNumber(x.Values) }));

            #endregion

            #region Symbols

            primitiveProcs["STRING->SYMBOL"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.StringToSymbol(x.Values) }));
            primitiveProcs["SYMBOL->STRING"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.SymbolToString(x.Values) }));

            #endregion

            #region Strings and Characters

            #region Character Ordering

            primitiveProcs["CHAR=?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsCharEq(x.Values) }));
            primitiveProcs["CHAR<?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsCharLess(x.Values) }));
            primitiveProcs["CHAR>?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsCharGreater(x.Values) }));
            primitiveProcs["CHAR<=?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsCharLessEq(x.Values) }));
            primitiveProcs["CHAR>=?"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IsCharGreaterEq(x.Values) }));

            primitiveProcs["CHAR->INTEGER"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.CharToInteger(x.Values) }));
            primitiveProcs["INTEGER->CHAR"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.IntegerToChar(x.Values) }));

            #endregion

            #region Strings

            primitiveProcs["MAKE-STRING"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.MakeString(x.Values) }));
            primitiveProcs["STRING"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.StringFromChars(x.Values) }));
            primitiveProcs["STRING-LENGTH"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.StringLength(x.Values) }));
            primitiveProcs["STRING-REF"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.StringRef(x.Values) }));
            primitiveProcs["STRING-SET!"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.StringSet(x.Values) }));
            primitiveProcs["STRING-APPEND"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.StringAppend(x.Values) }));
            primitiveProcs["SUBSTRING"] = (cont, x) => new TEvalResult(() => cont(new IEvaluable[] { Primitives.Substring(x.Values) }));

            #endregion

            #endregion

            #region Primitive Eval and Apply

            primitiveProcs["APPLY"] = (cont, x) =>
            {
                var args = ((Pair)x.Cdr).Values;
                var firstArgCount = args.Count() - 1;
                var applyArgs = Pair.CreateList(args.Take(firstArgCount).Concat(((Pair)args.Last()).Values));
                return new TEvalResult(() => TApply(x.Car, applyArgs, cont));
            };
            primitiveProcs["EVAL"] = (cont, x) =>
            {
                if (x.Cdr.IsNull())
                    return new TEvalResult(() => 
                        TEval(x.Car, (Environment)environment.Lookup(Symbol.Lookup("USER-INITIAL-ENVIRONMENT")), cont));
                else
                    return new TEvalResult(() => TEval(x.Car, (Environment)x.Cadr, cont));
            };

            #endregion
        }

        #endregion

        #region Environment

        private Environment SetupEnvironment()
        {
            var primitiveNames = primitiveProcs.Keys;
            var primitiveLambdas = primitiveProcs.Keys.Select(k => new Pair(Symbol.Lookup("PRIMITIVE"), new Pair(Symbol.Lookup(k), Pair.Empty)));
            var systemGlobalEnv = Environment.Empty.Extend(primitiveNames.Select(n => Symbol.Lookup(n)), primitiveLambdas);

            systemGlobalEnv.Define(Symbol.True, Symbol.True);
            systemGlobalEnv.Define(Symbol.False, Symbol.False);
            systemGlobalEnv.Define(Symbol.Lookup("CALL/CC"), Symbol.Lookup("CALL/CC"));
            systemGlobalEnv.Define(Symbol.Lookup("CALL-WITH-CURRENT-CONTINUATION"), Symbol.Lookup("CALL/CC"));
            var initialEnv = systemGlobalEnv.Extend();

            systemGlobalEnv.Define(Symbol.Lookup("USER-INITIAL-ENVIRONMENT"), initialEnv);
            systemGlobalEnv.Define(Symbol.Lookup("SYSTEM-GLOBAL-ENVIRONMENT"), systemGlobalEnv);

            return initialEnv;
        }

        #endregion

        #region Rewriters

        private void SetupRewriters()
        {
            rewriters = new Dictionary<Symbol, TRewriter>();

            rewriters[Symbol.Lookup("DELAY")] = Rewriters.MakePromise;
            rewriters[Symbol.Lookup("LET")] = Rewriters.LetToCombination;
            rewriters[Symbol.Lookup("LET*")] = Rewriters.LetStarToNestedLets;
            rewriters[Symbol.Lookup("LETREC")] = Rewriters.LetRecToLet;
            rewriters[Symbol.Lookup("QUASIQUOTE")] = Rewriters.ExpandQuasiquote;
            rewriters[Symbol.Lookup("COND")] = Rewriters.CondToIf;
            rewriters[Symbol.Lookup("CASE")] = Rewriters.CaseToIf;
            rewriters[Symbol.Lookup("RECEIVE")] = Rewriters.ReceiveToCWV;
            rewriters[Symbol.Lookup("OR")] = Rewriters.OrToIf;
            rewriters[Symbol.Lookup("AND")] = Rewriters.AndToIf;
        }

        private IEvaluable MaybeRewrite(Pair exp)
        {
            while ((exp.IsPair() && ((Pair)exp).Car is Symbol && rewriters.ContainsKey((Symbol)((Pair)exp).Car)))
                exp = (Pair)rewriters[(Symbol)exp.Car](exp);

            return exp;
        }

        #endregion

        #endregion

        #region Public Interface

        public void Evaluate(IEvaluable exp)
        {
#if !SCHEME_DEBUG
            try
            {
#endif
#if SCHEME_PROFILING
                var sw = new System.Diagnostics.Stopwatch();
                sw.Start();
#endif
                var result = TEval(exp, environment, val => new TEvalResult(val)).Value;
#if SCHEME_PROFILING
                sw.Stop();
#endif
                finalCont(result);
#if SCHEME_PROFILING
                Console.WriteLine("Ellapsed time: {0}", sw.ElapsedMilliseconds / 1000.0);
#endif
#if !SCHEME_DEBUG
            }
            catch (InvalidCastException ex)
            {
                errorCont(new AST.String(ex.Message));
            }
            catch (EvaluatorException ex)
            {
                errorCont(new AST.String(ex.Message));
            }
            catch (Runtime.SchemeRuntimeException ex)
            {
                errorCont(new AST.String(ex.Message));
            }
#endif
        }

        public void Repl()
        {
            while (true)
            {
                var parse = readProc();
                if (parse == null)
                    errorCont(new AST.String("Could not parse input"));
                else
                    Evaluate(parse);
            }
        }

        #endregion

        #region Evaluation and Application using CPS and Trampolining

        #region Evaluation

        private TEvalResult TEval(IEvaluable exp, Environment env, Func<EvalResult, TEvalResult> cont)
        {
            if (exp is Pair)
                exp = MaybeRewrite((Pair)exp);
#if SCHEME_DEBUG
            Console.WriteLine("EVAL: {0}", exp);
#endif
            // Dispatch on type
            if (exp.IsSelfEvaluating())
                return cont(new IEvaluable[] { exp });
            else if (exp.IsVariable())
                return cont(new IEvaluable[] { env.Lookup((Symbol)exp) });
            else if (exp.IsTaggedList("LOAD"))
                return LoadFile(((Pair)exp).Cadr, env, cont);
            else if (exp.IsTaggedList("QUOTE"))
                return new TEvalResult(() => cont(new IEvaluable[] { ((Pair)exp).Cadr }));
            else if (exp.IsTaggedList("SET!"))
                return TEvalAssignment(exp, env, cont);
            else if (exp.IsTaggedList("DEFINE"))
                return TEvalDefinition(exp, env, cont);
            else if (exp.IsTaggedList("IF"))
                return TEvalIf(exp, env, cont);
            else if (exp.IsTaggedList("LAMBDA"))
            {
                var parameters = ((Pair)exp).Cadr;
                var body = Rewriters.ScanOutDefines((Pair)((Pair)exp).Cddr);

                return cont(new IEvaluable[] 
                { 
                    new Pair(Symbol.Lookup("PROCEDURE"), new Pair(parameters, new Pair(body, new Pair(env, Pair.Empty))))
                });
            }
            else if (exp.IsTaggedList("BEGIN"))
                return TEvalSequence(((Pair)exp).Cdr, env, cont);
            else if (exp.IsTaggedList("THE-ENVIRONMENT") && ((Pair)exp).Cdr.IsNull())
                return cont(new IEvaluable[] { env });
            else if (exp.IsTaggedList("MAKE-ENVIRONMENT"))
                return TEvalMakeEnv(exp, env, cont);
            else if (exp.IsTaggedList("CALL-WITH-VALUES"))
                return TCallWithValues((Pair)exp, env, cont);
            else if (exp.IsPair())
            {
                var e = (Pair)exp;

                return TEval(((Pair)exp).Car, env, operatorVal =>
                {
                    Func<EvalResult, TEvalResult> c2 = operandsVal =>
                        TApply(operatorVal.First(), (Pair)operandsVal.First(), cont);
                    return EvalOperands((Pair)((Pair)exp).Cdr, env, c2);
                });
            }
            else
                throw new EvaluatorException(string.Format("Unknown expression type: {0}", exp.GetType()));
        }

        private TEvalResult EvalOperands(Pair exps, Environment env, Func<EvalResult, TEvalResult> cont)
        {
            if (exps.IsNull())
                return cont(new IEvaluable[] { Pair.Empty });
            return TEval(exps.Car, env, headVal =>
            {
                Func<EvalResult, TEvalResult> c2 = tailVal => cont(new IEvaluable[] { new Pair(headVal.First(), tailVal.First()) });
                return EvalOperands((Pair)exps.Cdr, env, c2);
            });
        }

        #endregion

        #region Application

        private TEvalResult TApply(IEvaluable procedure, Pair arguments, Func<EvalResult, TEvalResult> cont)
        {
            if (procedure == Symbol.Lookup("CALL/CC"))
            {
#if SCHEME_DEBUG
                Console.WriteLine("APPLY-CALL/CC: {0} / {1}", procedure, arguments);
#endif
                return new TEvalResult(() =>
                    TApply(arguments.Car, new Pair(
                        new Pair(Symbol.Lookup("CONTINUATION"), new Pair(new Continuation(cont), Pair.Empty)),
                            Pair.Empty), cont));
            }
            else if (procedure.IsTaggedList("PRIMITIVE"))
            {
#if SCHEME_DEBUG
                Console.WriteLine("APPLY-PRIMITIVE: {0} / {1}", procedure, arguments);
#endif
                var procName = (Symbol)((Pair)procedure).Cadr;
                return primitiveProcs[procName.Name](cont, arguments);
            }
            else if (procedure.IsTaggedList("CONTINUATION"))
            {
#if SCHEME_DEBUG
                Console.WriteLine("APPLY-CONTINUATION: {0} / {1}", procedure, arguments);
#endif
                var contImpl = (Continuation)((Pair)procedure).Cadr;
                return new TEvalResult(() => contImpl.ContinuationProc(arguments.Values));
            }
            else if (procedure.IsTaggedList("PROCEDURE"))
            {
#if SCHEME_DEBUG
                Console.WriteLine("APPLY-INTERPRETED: {0} / {1}", procedure, arguments);
#endif
                var env = (Environment)((Pair)procedure).Cadddr;
                var body = ((Pair)procedure).Caddr;
                if (((Pair)procedure).Cadr.IsPair() || ((Pair)procedure).Cadr.IsNull())
                {
                    var variables = (Pair)((Pair)procedure).Cadr;
                    if (!variables.IsDottedPair)
                        return TEvalSequence(body,
                            env.Extend(variables.Values.Select(v => (Symbol)v), arguments.Values),
                            cont);
                    else
                    {
                        var beforeDot = variables.ItemsBeforeDot;
                        Pair beforeList;
                        if (beforeDot.IsPair())
                            beforeList = (Pair)beforeDot;
                        else
                            beforeList = Pair.CreateList(new IEvaluable[] { beforeDot });

                        var afterDot = variables.ItemAfterDot;
                        var beforeCount = beforeList.Values.Count();
                        var vars = beforeList.Values.Select(v => (Symbol)v)
                            .Concat(Pair.CreateList(new IEvaluable[] { afterDot }).Values.Select(v => (Symbol)v));
                        var vals = arguments.Values.Take(beforeCount)
                            .Concat(
                                Pair.CreateList(new IEvaluable[] { Pair.CreateList(arguments.Values.Skip(beforeCount)) }).Values);
                        return TEvalSequence(body, env.Extend(vars, vals), cont);
                    }
                }
                else
                    return TEvalSequence(body,
                        env.Extend(new Symbol[] { (Symbol)((Pair)procedure).Cadr }, new IEvaluable[] { arguments }),
                        cont);
            }
            else
                throw new EvaluatorException(string.Format("Unknown procedure type: {0}", procedure));
        }

        #endregion

        #region Sequences

        private TEvalResult TEvalSequence(IEvaluable exps, Environment env, Func<EvalResult, TEvalResult> cont)
        {
#if SCHEME_DEBUG
            Console.WriteLine("EVAL-SEQUENCE: {0}", exps);
#endif
            var seq = exps as Pair;
            if (seq.Cdr.IsNull())
                return TEval(seq.Car, env, cont);
            else
                return TEval(seq.Car, env, val =>
                {
                    return TEvalSequence(seq.Cdr, env, cont);
                });
        }

        #endregion

        #region Control Constructs

        private TEvalResult TCallWithValues(Pair exps, Environment env, Func<EvalResult, TEvalResult> cont)
        {
#if SCHEME_DEBUG
            Console.WriteLine("EVAL-CALL-WITH-VALUES: {0}", exps);
#endif
            var producer = exps.Cadr;
            var consumer = exps.Caddr;
            return TEval(producer, env, producerProc =>
                TEval(consumer, env, consumerProc =>
                    TApply(producerProc.First(), Pair.Empty, values =>
                        TApply(consumerProc.First(), Pair.CreateList(values), cont))));
        }

        #endregion

        #region If

        private TEvalResult TEvalIf(IEvaluable exp, Environment env, Func<EvalResult, TEvalResult> cont)
        {
#if SCHEME_DEBUG
            Console.WriteLine("EVAL-IF: {0}", exp);
#endif
            Func<Pair, IEvaluable> IfAlternative = e =>
            {
                if (!e.Cdddr.IsNull())
                    return e.Cadddr;
                else
                    return Symbol.False;
            };
            var p = exp as Pair;

            return TEval(p.Cadr, env, pred =>
            {
                if (pred.First().IsTrue())
                    return TEval(p.Caddr, env, cont);
                else
                    return TEval(IfAlternative(p), env, cont);
            });
        }

        #endregion

        #region Assignment and Definition

        private TEvalResult TEvalAssignment(IEvaluable exp, Environment env, Func<EvalResult, TEvalResult> cont)
        {
#if SCHEME_DEBUG
            Console.WriteLine("EVAL-SET!: {0}", exp);
#endif
            var e = exp as Pair;
            return TEval(e.Caddr, env, val =>
            {
                env.SetValue((Symbol)e.Cadr, val.First());
                return cont(new IEvaluable[] { Symbol.Unspecified });
            });
        }

        private TEvalResult TEvalDefinition(IEvaluable exp, Environment env, Func<EvalResult, TEvalResult> cont)
        {
#if SCHEME_DEBUG
            Console.WriteLine("EVAL-DEFINE: {0}", exp);
#endif
            var e = exp as Pair;
            var defVariable = e.Cadr is Symbol ? (Symbol)e.Cadr : (Symbol)e.Caadr;
            var defValue = e.Cadr is Symbol ? e.Caddr : new Pair(Symbol.Lookup("LAMBDA"), new Pair(e.Cdadr, e.Cddr));

            if (!e.Cddr.IsNull())
                return TEval(defValue, env, val =>
                {
                    env.Define(defVariable, val.First());
                    return cont(new IEvaluable[] { defVariable });
                });
            else
            {
                env.Define(defVariable, Symbol.Unspecified);
                return cont(new IEvaluable[] { defVariable });
            }
        }

        #endregion

        #region Environment Management

        private TEvalResult TEvalMakeEnv(IEvaluable exp, Environment env, Func<EvalResult, TEvalResult> cont)
        {
            var exps = ((Pair)exp).Cdr;
            var newEnv = env.Extend();
            return TEvalSequence(exps, newEnv, val => cont(new IEvaluable[] { newEnv }));
        }

        #endregion

        #region Source File Loading

        private TEvalResult LoadFile(IEvaluable exp, Environment env, Func<EvalResult, TEvalResult> cont)
        {
            var fileName = ((Runtime.AST.String)exp).Value;
            var text = "(\n" + new System.IO.StreamReader(fileName).ReadToEnd() + "\n(unspecified-value))";
            var parse = Runtime.Parser.SchemeParser.Parse(text);

            return new TEvalResult(() => TEvalSequence(parse, env, cont));
        }

        #endregion

        #endregion
    }

    #endregion

    #region Call/CC support

    internal class Continuation : IEvaluable
    {
        Func<EvalResult, TEvalResult> c;

        public Continuation(Func<EvalResult, TEvalResult> cont) { c = cont; }

        public Func<EvalResult, TEvalResult> ContinuationProc
        {
            get { return c; }
        }

        public override string ToString()
        {
            return "#<continuation>";
        }
    }

    #endregion
}
